home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2001 May / SGI Freeware 2001 May - Disc 1.iso / dist / fw_stylesheets.idb / usr / freeware / bin / collateindex.pl.z / collateindex.pl
Text File  |  2000-07-20  |  16KB  |  597 lines
  1. # -*- Perl -*-
  2. #
  3. # $Id: collateindex.pl,v 1.1.1.3 1999/06/28 08:56:03 rosalia Exp $
  4.  
  5. use Getopt::Std;
  6.  
  7. $usage = "Usage: $0 <opts> file
  8. Where <opts> are:
  9.        -p        Link to points in the document.  The default is to link
  10.                  to the closest containing section.
  11.        -g        Group terms with IndexDiv based on the first letter 
  12.                  of the term (or its sortas attribute).
  13.                  (This probably doesn't handle i10n particularly well)
  14.        -s name   Name the IndexDiv that contains symbols.  The default
  15.                  is 'Symbols'.  Meaningless if -g is not used.
  16.        -t name   Title for the index.
  17.        -P file   Read a preamble from file.  The content of file will
  18.                  be inserted before the <index> tag.
  19.        -i id     The ID for the <index> tag.
  20.        -o file   Output to file. Defaults to stdout.
  21.        -S scope  Scope of the index, must be 'all', 'local', or 'global'.
  22.                  If unspecified, 'all' is assumed.
  23.        -I scope  The implied scope, must be 'all', 'local', or 'global'.
  24.                  IndexTerms which do not specify a scope will have the
  25.                  implied scope.  If unspecified, 'all' is assumed.
  26.        -x        Make a SetIndex.
  27.        -f        Force the output file to be written, even if it appears
  28.                  to have been edited by hand.
  29.        -N        New index (generates an empty index file).
  30.        file      The file containing index data generated by Jade
  31.                  with the DocBook HTML Stylesheet.\n";
  32.  
  33. die $usage if ! getopts('Dfgi:NpP:s:o:S:I:t:x');
  34.  
  35. $linkpoints   = $opt_p;
  36. $lettergroups = $opt_g;
  37. $symbolsname  = $opt_s || "Symbols";
  38. $title        = $opt_t;
  39. $preamble     = $opt_P;
  40. $outfile      = $opt_o || '-';
  41. $indexid      = $opt_i;
  42. $scope        = uc($opt_S) || 'ALL';
  43. $impliedscope = uc($opt_I) || 'ALL';
  44. $setindex     = $opt_x;
  45. $forceoutput  = $opt_f;
  46. $newindex     = $opt_N;
  47. $debug        = $opt_D;
  48.  
  49. $indextag     = $setindex ? 'setindex' : 'index';
  50.  
  51. if ($newindex) {
  52.     safe_open(*OUT, $outfile);
  53.     if ($indexid) {
  54.     print OUT "<$indextag ID='$indexid'>\n\n";
  55.     } else {
  56.     print OUT "<$indextag>\n\n";
  57.     }
  58.  
  59.     print OUT "<!-- This file was produced by collateindex.pl.         -->\n";
  60.     print OUT "<!-- Remove this comment if you edit this file by hand! -->\n";
  61.  
  62.     print OUT "</$indextag>\n";
  63.     exit 0;
  64. }
  65.  
  66. $dat = shift @ARGV || die $usage;
  67. die "$0: cannot find $dat.\n" if ! -f $dat;
  68.  
  69. %legal_scopes = ('ALL' => 1, 'LOCAL' => 1, 'GLOBAL' => 1);
  70. if ($scope && !$legal_scopes{$scope}) {
  71.     die "Invalid scope.\n$usage\n";
  72. }
  73. if ($impliedscope && !$legal_scopes{$impliedscope}) {
  74.     die "Invalid implied scope.\n$usage\n";
  75. }
  76.  
  77. @term = ();
  78. %id   = ();
  79.  
  80. $termcount = 0;
  81.  
  82. print STDERR "Processing $dat...\n";
  83.  
  84. # Read the index file, creating an array of objects.  Each object 
  85. # represents and indexterm and has fields for the content of the
  86. # indexterm
  87.  
  88. open (F, $dat);
  89. while (<F>) {
  90.     chop;
  91.  
  92.     if (/^\/indexterm/i) {
  93.     push (@term, $idx);
  94.     next;
  95.     }
  96.  
  97.     if (/^indexterm (.*)$/i) {
  98.     $termcount++;
  99.     $idx = {};
  100.     $idx->{'zone'} = {};
  101.     $idx->{'href'} = $1;
  102.     $idx->{'count'} = $termcount;
  103.     $idx->{'scope'} = $impliedscope;
  104.     next;
  105.     }
  106.  
  107.     if (/^indexpoint (.*)$/i) {
  108.     $idx->{'hrefpoint'} = $1;
  109.     next;
  110.     }
  111.  
  112.     if (/^title (.*)$/i) {
  113.     $idx->{'title'} = $1;
  114.     next;
  115.     }
  116.  
  117.     if (/^primary[\[ ](.*)$/i) {
  118.     if (/^primary\[(.*?)\] (.*)$/i) {
  119.         $idx->{'psortas'} = $1;
  120.         $idx->{'primary'} = $2;
  121.     } else {
  122.         $idx->{'psortas'} = $1;
  123.         $idx->{'primary'} = $1;
  124.     }
  125.     next;
  126.     }
  127.  
  128.     if (/^secondary[\[ ](.*)$/i) {
  129.     if (/^secondary\[(.*?)\] (.*)$/i) {
  130.         $idx->{'ssortas'} = $1;
  131.         $idx->{'secondary'} = $2;
  132.     } else {
  133.         $idx->{'ssortas'} = $1;
  134.         $idx->{'secondary'} = $1;
  135.     }
  136.     next;
  137.     }
  138.  
  139.     if (/^tertiary[\[ ](.*)$/i) {
  140.     if (/^tertiary\[(.*?)\] (.*)$/i) {
  141.         $idx->{'tsortas'} = $1;
  142.         $idx->{'tertiary'} = $2;
  143.     } else {
  144.         $idx->{'tsortas'} = $1;
  145.         $idx->{'tertiary'} = $1;
  146.     }
  147.     next;
  148.     }
  149.  
  150.     if (/^see (.*)$/i) {
  151.     $idx->{'see'} = $1;
  152.     next;
  153.     }
  154.  
  155.     if (/^seealso (.*)$/i) {
  156.     $idx->{'seealso'} = $1;
  157.     next;
  158.     }
  159.  
  160.     if (/^significance (.*)$/i) {
  161.     $idx->{'significance'} = $1;
  162.     next;
  163.     }
  164.  
  165.     if (/^class (.*)$/i) {
  166.     $idx->{'class'} = $1;
  167.     next;
  168.     }
  169.  
  170.     if (/^scope (.*)$/i) {
  171.     $idx->{'scope'} = uc($1);
  172.     next;
  173.     }
  174.  
  175.     if (/^startref (.*)$/i) {
  176.     $idx->{'startref'} = $1;
  177.     next;
  178.     }
  179.  
  180.     if (/^id (.*)$/i) {
  181.     $idx->{'id'} = $1;
  182.     $id{$1} = $idx;
  183.     next;
  184.     }
  185.  
  186.     if (/^zone (.*)$/i) {
  187.     my($href) = $1;
  188.     $_ = scalar(<F>);
  189.     chop;
  190.     die "Bad zone: $_\n" if !/^title (.*)$/i;
  191.     $idx->{'zone'}->{$href} = $1;
  192.     next;
  193.     }
  194.  
  195.     die "Unrecognized: $_\n";
  196. }
  197. close (F);
  198.  
  199. print STDERR "$termcount entries loaded...\n";
  200.  
  201. # Fixup the startrefs...
  202. # In DocBook, STARTREF is a #CONREF attribute; support this by copying
  203. # all of the fields from the indexterm with the id specified by STARTREF
  204. # to the indexterm that has the STARTREF.
  205. foreach $idx (@term) {
  206.     my($ididx, $field);
  207.     if ($idx->{'startref'}) {
  208.     $ididx = $id{$idx->{'startref'}};
  209.     foreach $field ('primary', 'secondary', 'tertiary', 'see', 'seealso',
  210.                 'psortas', 'ssortas', 'tsortas', 'significance',
  211.                 'class', 'scope') {
  212.         $idx->{$field} = $ididx->{$field};
  213.     }
  214.     }
  215. }
  216.  
  217. # Sort the index terms
  218. @term = sort termsort @term;
  219.  
  220. # Move all of the non-alphabetic entries to the front of the index.
  221. @term = sortsymbols(@term);
  222.  
  223. safe_open(*OUT, $outfile);
  224.  
  225. # Write the index...
  226. if ($indexid) {
  227.     print OUT "<$indextag ID='$indexid'>\n\n";
  228. } else {
  229.     print OUT "<$indextag>\n\n";
  230. }
  231.  
  232. print OUT "<!-- This file was produced by collateindex.pl.         -->\n";
  233. print OUT "<!-- Remove this comment if you edit this file by hand! -->\n";
  234.  
  235. print OUT "<!-- ULINK is abused here.
  236.       
  237.       The URL attribute holds the URL that points from the index entry
  238.       back to the appropriate place in the output produced by the HTML
  239.       stylesheet. (It's much easier to calculate this URL in the first
  240.       pass.)
  241.  
  242.       The Role attribute holds the ID (either real or manufactured) of
  243.       the corresponding INDEXTERM.  This is used by the print backends
  244.       to produce page numbers.
  245.  
  246.       The entries below are sorted and collated into the correct order.
  247.       Duplicates may be removed in the HTML backend, but in the print
  248.       backends, it is impossible to suppress duplicate pages or coalesce
  249.       sequences of pages into a range.
  250. -->\n\n";
  251.  
  252. print OUT "<title>$title</title>\n\n" if $title;
  253.  
  254. $last = {};     # the last indexterm we processed
  255. $first = 1;     # this is the first one
  256. $group = "";    # we're not in a group yet
  257. $lastout = "";  # we've not put anything out yet
  258.  
  259. foreach $idx (@term) {
  260.     next if $idx->{'startref'}; # no way to represent spans...
  261.     next if ($idx->{'scope'} eq 'LOCAL') && ($scope eq 'GLOBAL');
  262.     next if ($idx->{'scope'} eq 'GLOBAL') && ($scope eq 'LOCAL');
  263.     next if &same($idx, $last); # suppress duplicates
  264.  
  265.     $termcount--;
  266.  
  267.     # If primary changes, output a whole new index term, otherwise just
  268.     # output another secondary or tertiary, as appropriate.  We know from
  269.     # sorting that the terms will always be in the right order.
  270.     if (!&tsame($last, $idx, 'primary')) { 
  271.     print "DIFF PRIM\n" if $debug;
  272.     &end_entry() if not $first;
  273.  
  274.     if ($lettergroups) {
  275.         # If we're grouping, make the right indexdivs
  276.         $letter = $idx->{'psortas'};
  277.         $letter = $idx->{'primary'} if !$letter;
  278.         $letter = uc(substr($letter, 0, 1));
  279.         
  280.         # symbols are a special case
  281.         if (($letter lt 'A') || ($letter gt 'Z')) {
  282.         if (($group eq '')
  283.             || (($group ge 'A') && ($group le 'Z'))) {
  284.             print OUT "</indexdiv>\n" if !$first;
  285.             print OUT "<indexdiv><title>$symbolsname</title>\n\n";
  286.             $group = $letter;
  287.         }
  288.         } elsif (($group eq '') || ($group ne $letter)) {
  289.         print OUT "</indexdiv>\n" if !$first;
  290.         print OUT "<indexdiv><title>$letter</title>\n\n";
  291.         $group = $letter;
  292.         }
  293.     }
  294.  
  295.     $first = 0; # there can only be on first ;-)
  296.  
  297.     print OUT "<indexentry>\n";
  298.     print OUT "  <primaryie>", $idx->{'primary'};
  299.     $lastout = "primaryie";
  300.  
  301.      if ($idx->{'secondary'}) {
  302.         print OUT "\n  </primaryie>\n";
  303.         print OUT "  <secondaryie>", $idx->{'secondary'};
  304.         $lastout = "secondaryie";
  305.     };
  306.  
  307.     if ($idx->{'tertiary'}) {
  308.         print OUT "\n  </secondaryie>\n";
  309.         print OUT "  <tertiaryie>", $idx->{'tertiary'};
  310.         $lastout = "tertiaryie";
  311.     }
  312.     } elsif (!&tsame($last, $idx, 'secondary')) {
  313.     print "DIFF SEC\n" if $debug;
  314.  
  315.     print OUT "\n  </$lastout>\n";
  316.  
  317.     print OUT "  <secondaryie>", $idx->{'secondary'};
  318.     $lastout = "secondaryie";
  319.     if ($idx->{'tertiary'}) {
  320.         print OUT "\n  </secondaryie>\n";
  321.         print OUT "  <tertiaryie>", $idx->{'tertiary'};
  322.         $lastout = "tertiaryie";
  323.     }
  324.     } elsif (!&tsame($last, $idx, 'tertiary')) {
  325.     print "DIFF TERT\n" if $debug;
  326.  
  327.     print OUT "\n  </$lastout>\n";
  328.  
  329.     if ($idx->{'tertiary'}) {
  330.         print OUT "  <tertiaryie>", $idx->{'tertiary'};
  331.         $lastout = "tertiaryie";
  332.     }
  333.     }
  334.  
  335.     &print_term($idx);
  336.     
  337.     $last = $idx;
  338. }
  339.  
  340. # Termcount is > 0 iff some entries were skipped.
  341. print STDERR "$termcount entries ignored...\n";
  342.  
  343. &end_entry();
  344.  
  345. print OUT "</indexdiv>\n" if $lettergroups;
  346. print OUT "</$indextag>\n";
  347.  
  348. close (OUT);
  349.  
  350. print STDERR "Done.\n";
  351.  
  352. sub same {
  353.     my($a) = shift;
  354.     my($b) = shift;
  355.  
  356.     my($aP) = $a->{'psortas'} || $a->{'primary'};   
  357.     my($aS) = $a->{'ssortas'} || $a->{'secondary'}; 
  358.     my($aT) = $a->{'tsortas'} || $a->{'tertiary'};  
  359.                                                 
  360.     my($bP) = $b->{'psortas'} || $b->{'primary'};   
  361.     my($bS) = $b->{'ssortas'} || $b->{'secondary'}; 
  362.     my($bT) = $b->{'tsortas'} || $b->{'tertiary'};  
  363.  
  364.     my($same);
  365.  
  366.     $aP =~ s/^\s*//; $aP =~ s/\s*$//; $aP = uc($aP);
  367.     $aS =~ s/^\s*//; $aS =~ s/\s*$//; $aS = uc($aS);
  368.     $aT =~ s/^\s*//; $aT =~ s/\s*$//; $aT = uc($aT);
  369.     $bP =~ s/^\s*//; $bP =~ s/\s*$//; $bP = uc($bP);
  370.     $bS =~ s/^\s*//; $bS =~ s/\s*$//; $bS = uc($bS);
  371.     $bT =~ s/^\s*//; $bT =~ s/\s*$//; $bT = uc($bT);
  372.  
  373. #    print "[$aP]=[$bP]\n";
  374. #    print "[$aS]=[$bS]\n";
  375. #    print "[$aT]=[$bT]\n";
  376.  
  377.     # Two index terms are the same if:
  378.     # 1. the primary, secondary, and tertiary entries are the same
  379.     #    (or have the same SORTAS)
  380.     # AND
  381.     # 2. They occur in the same titled section
  382.     # AND
  383.     # 3. They point to the same place
  384.     #
  385.     # Notes: Scope is used to suppress some entries, but can't be used
  386.     #          for comparing duplicates.
  387.     #        Interpretation of "the same place" depends on whether or
  388.     #          not $linkpoints is true.
  389.  
  390.     $same = (($aP eq $bP)
  391.          && ($aS eq $bS)
  392.          && ($aT eq $bT)
  393.          && ($a->{'title'} eq $b->{'title'})
  394.          && ($a->{'href'} eq $b->{'href'}));
  395.  
  396.     # If we're linking to points, they're only the same if they link
  397.     # to exactly the same spot.  (surely this is redundant?)
  398.     $same = $same && ($a->{'hrefpoint'} eq $b->{'hrefpoint'})
  399.     if $linkpoints;
  400.  
  401.     $same;
  402. }
  403.  
  404. sub tsame {
  405.     # Unlike same(), tsame only compares a single term
  406.     my($a) = shift;
  407.     my($b) = shift;
  408.     my($term) = shift;
  409.     my($sterm) = substr($term, 0, 1) . "sortas";
  410.     my($A, $B);
  411.  
  412.     $A = $a->{$sterm} || $a->{$term};
  413.     $B = $b->{$sterm} || $b->{$term};
  414.  
  415.     $A =~ s/^\s*//; $A =~ s/\s*$//; $A = uc($A);
  416.     $B =~ s/^\s*//; $B =~ s/\s*$//; $B = uc($B);
  417.  
  418.     return $A eq $B;
  419. }
  420.  
  421. sub end_entry {
  422.     # End any open elements...
  423.     print OUT "\n  </$lastout>\n" if $lastout;
  424.     print OUT "</indexentry>\n\n";
  425.     $lastout = "";
  426. }
  427.  
  428. sub print_term {
  429.     # Print out the links for an indexterm.  There can be more than
  430.     # one if the term has a ZONE that points to more than one place.
  431.     # (do we do the right thing in that case?)
  432.     my($idx) = shift;
  433.     my($key, $indent, @hrefs);
  434.     my(%href) = ();
  435.     my(%phref) = ();
  436.  
  437.     $indent = "    ";
  438.  
  439.     if ($idx->{'see'}) {
  440.     # it'd be nice to make this a link...
  441.     if ($lastout) {
  442.         print OUT "\n  </$lastout>\n";
  443.         $lastout = "";
  444.     }
  445.     print OUT $indent, "<seeie>", $idx->{'see'}, "</seeie>\n";
  446.     return;
  447.     }
  448.  
  449.     if ($idx->{'seealso'}) {
  450.     # it'd be nice to make this a link...
  451.     if ($lastout) {
  452.         print OUT "\n  </$lastout>\n";
  453.         $lastout = "";
  454.     }
  455.     print OUT $indent, "<seealsoie>", $idx->{'seealso'}, "</seealsoie>\n";
  456.     return;
  457.     }
  458.  
  459.     if (keys %{$idx->{'zone'}}) {
  460.     foreach $key (keys %{$idx->{'zone'}}) {
  461.         $href{$key} = $idx->{'zone'}->{$key};
  462.         $phref{$key} = $idx->{'zone'}->{$key};
  463.     }
  464.     } else {
  465.     $href{$idx->{'href'}} = $idx->{'title'};
  466.     $phref{$idx->{'href'}} = $idx->{'hrefpoint'};
  467.     }
  468.  
  469.     # We can't use <LINK> because we don't know the ID of the term in the
  470.     # original source (and, in fact, it might not have one).
  471.     print OUT ",\n";
  472.     @hrefs = keys %href;
  473.     while (@hrefs) {
  474.     my($linkend) = "";
  475.     my($role) = "";
  476.     $key = shift @hrefs;
  477.     if ($linkpoints) {
  478.         $linkend = $phref{$key};
  479.     } else {
  480.         $linkend = $key;
  481.     }
  482.  
  483.     $role = $linkend;
  484.     $role = $1 if $role =~ /\#(.*)$/;
  485.  
  486.     print OUT $indent;
  487.     print OUT "<ulink url=\"$linkend\" role=\"$role\">";
  488.     print OUT "<emphasis>" if ($idx->{'significance'} eq 'PREFERRED');
  489.     print OUT $href{$key};
  490.     print OUT "</emphasis>" if ($idx->{'significance'} eq 'PREFERRED');
  491.     print OUT "</ulink>";
  492.     }
  493. }
  494.  
  495. sub termsort {
  496.     my($aP) = $a->{'psortas'} || $a->{'primary'};   
  497.     my($aS) = $a->{'ssortas'} || $a->{'secondary'}; 
  498.     my($aT) = $a->{'tsortas'} || $a->{'tertiary'};  
  499.     my($ap) = $a->{'count'};
  500.                                                 
  501.     my($bP) = $b->{'psortas'} || $b->{'primary'};   
  502.     my($bS) = $b->{'ssortas'} || $b->{'secondary'}; 
  503.     my($bT) = $b->{'tsortas'} || $b->{'tertiary'};  
  504.     my($bp) = $b->{'count'};
  505.  
  506.     $aP =~ s/^\s*//; $aP =~ s/\s*$//; $aP = uc($aP);
  507.     $aS =~ s/^\s*//; $aS =~ s/\s*$//; $aS = uc($aS);
  508.     $aT =~ s/^\s*//; $aT =~ s/\s*$//; $aT = uc($aT);
  509.     $bP =~ s/^\s*//; $bP =~ s/\s*$//; $bP = uc($bP);
  510.     $bS =~ s/^\s*//; $bS =~ s/\s*$//; $bS = uc($bS);
  511.     $bT =~ s/^\s*//; $bT =~ s/\s*$//; $bT = uc($bT);
  512.  
  513.     if ($aP eq $bP) {
  514.     if ($aS eq $bS) {
  515.         if ($aT eq $bT) {
  516.         # make sure seealso's always sort to the bottom
  517.         return 1 if ($a->{'seealso'});
  518.         return -1  if ($b->{'seealso'});
  519.         # if everything else is the same, keep these elements
  520.         # in document order (so the index links are in the right
  521.         # order)
  522.         return $ap <=> $bp;
  523.         } else {
  524.         return $aT cmp $bT;
  525.         }
  526.     } else {
  527.         return $aS cmp $bS;
  528.     }
  529.     } else {
  530.     return $aP cmp $bP;
  531.     }
  532. }
  533.  
  534. sub sortsymbols {
  535.     my(@term) = @_;
  536.     my(@new) = ();
  537.     my(@sym) = ();
  538.     my($letter);
  539.     my($idx);
  540.  
  541.     # Move the non-letter things to the front.  Should digits be thier
  542.     # own group?  Maybe...
  543.     foreach $idx (@term) {
  544.     $letter = $idx->{'psortas'};
  545.     $letter = $idx->{'primary'} if !$letter;
  546.     $letter = uc(substr($letter, 0, 1));
  547.  
  548.     if (($letter lt 'A') || ($letter gt 'Z')) {
  549.         push (@sym, $idx);
  550.     } else {
  551.         push (@new, $idx);
  552.     }
  553.     }
  554.  
  555.     return (@sym, @new);
  556. }
  557.  
  558. sub safe_open {
  559.     local(*OUT) = shift;
  560.     local(*F, $_);
  561.  
  562.     if (($outfile ne '-') && (!$forceoutput)) {
  563.     my($handedit) = 1;
  564.     if (open (OUT, $outfile)) {
  565.         while (<OUT>) {
  566.         if (/<!-- Remove this comment if you edit this file by hand! -->/){
  567.             $handedit = 0;
  568.             last;
  569.         }
  570.         } 
  571.         close (OUT);
  572.     } else {
  573.         $handedit = 0;
  574.     }
  575.     
  576.     if ($handedit) {
  577.         print "\n$outfile appears to have been edited by hand; use -f or\n";
  578.         print "      change the output file.\n";
  579.         exit 1;
  580.     }
  581.     }
  582.  
  583.     open (OUT, ">$outfile") || die "$usage\nCannot write to $outfile.\n";
  584.  
  585.     if ($preamble) { 
  586.     # Copy the preamble
  587.     if (open(F, $preamble)) {
  588.         while (<F>) {
  589.         print OUT $_;
  590.         }
  591.         close(F);
  592.     } else {
  593.         warn "$0: cannot open preamble $preamble.\n";
  594.     }
  595.     }
  596. }
  597.